home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / datload.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-20  |  2KB  |  95 lines
  1.  
  2. {$i-,v-}
  3. program PictureLoader;
  4. { Display picture (pal at 0, data at $300), by Bas van Gaalen, Holland, PD }
  5. uses
  6.   crt,dos;
  7.  
  8. const
  9.   Gseg = $A000;
  10.  
  11. type
  12.   Str80 = string[80];
  13.   BufTp = array[0..4095] of byte;
  14.   PalBuf = array[0..$2ff] of byte;
  15.  
  16. var
  17.   PicFile  : file;
  18.   Palette  : PalBuf;
  19.   Buffer   : BufTp;
  20.   FileName : pathstr;
  21.   I,BufCt  : word;
  22.   NofRead  : integer;
  23.  
  24. {----------------------------------------------------------------------------}
  25.  
  26. procedure Error(Err : Str80);
  27.  
  28. begin
  29.   writeln;
  30.   writeln(Err);
  31.   halt(1);
  32. end;
  33.  
  34. {----------------------------------------------------------------------------}
  35.  
  36. procedure SetGraphics(Mode : byte); assembler;
  37.  
  38. asm
  39.   mov AH,0
  40.   mov AL,Mode
  41.   int 10h
  42. end;
  43.  
  44. {----------------------------------------------------------------------------}
  45.  
  46. procedure InstallColors(Buf : PalBuf);
  47.  
  48.   procedure SetColor(Color,Red,Green,Blue : byte);
  49.  
  50.   begin
  51.     port[$3C8] := Color;
  52.     port[$3C9] := Red;
  53.     port[$3C9] := Green;
  54.     port[$3C9] := Blue;
  55.   end;
  56.  
  57. var
  58.   I : byte;
  59.   C : word;
  60.  
  61. begin
  62.   C := 0;
  63.   for I := 0 to 255 do begin
  64.     SetColor(I,Buf[C],Buf[C+1],Buf[C+2]);
  65.     inc(C,3);
  66.   end;
  67. end;
  68.  
  69. {----------------------------------------------------------------------------}
  70.  
  71. begin
  72.   FileName := paramstr(1);
  73.   if FileName = '' then begin
  74.     writeln('Load raw picture. Please enter filename on commandline.');
  75.     halt;
  76.   end;
  77.   assign(PicFile,FileName);
  78.   reset(PicFile,1); if ioresult <> 0 then Error(FileName+' not found in current dir');
  79.  
  80.   blockread(PicFile,Palette,$300);
  81.   SetGraphics($13);
  82.   InstallColors(Palette);
  83.  
  84.   BufCt := 0;
  85.   repeat
  86.     blockread(PicFile,Buffer,4096,NofRead);
  87.     for I := 0 to NofRead-1 do mem[Gseg:BufCt+I] := Buffer[I];
  88.     inc(BufCt,NofRead);
  89.   until NofRead < 4096;
  90.   close(PicFile);
  91.  
  92.   repeat until keypressed;
  93.   SetGraphics(3);
  94. end.
  95.